COMMENT ⊗   VALID 00008 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	entry begin comment The output module of TEX.
C00004 00003	initialization: initout,declareofil
C00008 00004	General description of the shipout procedure.
C00010 00005	some macro and subroutine definitions
C00014 00006	The recursive traversal procedures: vlistout,hlistout
C00026 00007	internal procedure shipout(integer p) # the main output procedure,produces one page
C00028 00008	internal procedure closeout # just before TEX stops, do this
C00030 ENDMK
C⊗;
entry; begin comment The output module of TEX.

(It is wise to read the box data structure definitions in TEXSEM
before going very deeply into the following code.)

Each TEXOUT module is supposed to include the following procedures
invoked by the main program:

	initout			gets the output module started initially
	declareofil(string s)	called when the output file name is known
	shipout(integer p)	called for each nonempty page to be output
	closeout		finishes the output

This routine produces output in "device independent" format, described below.
This format is contains enough information to probably easily be transformed
into a format suitable for a wide range of actual devices.  (It is certainly
sufficient for our Versatec and Alphatype).  This program has been hacked by
DRF from the original XGP output routine written by DEK.

Routines for other devices will probably have a rather similar structure;

require "TEXHDR.SAI" source_file;
require "
	Note: This output module prepares device-independent files. " message;
require "{}{}" delimiters; "used for macros" comment for SCORE ;
comment initialization: initout,declareofil;

IFTENEX external integer _skip_; ENDTENEX
internal string ofilext # filename extension for output;
internal string deviceext # extension to use in font information files;
internal string ofilname # output file name, set by first \input;
internal string libraryarea # default system area for fonts, also look here
				for \input things;
saf integer array fontused[0:nfonts-1] # mark if font has been used;
integer dvichan # output channel number;

boolean nooutputyet # is there at least one page in the DVI file? ;
integer lastfont # most recently used font;
real maxpagewidth,maxpageheight;
integer thispageptr,lastpageptr;

# these things are PUSHed and POPed ;
real x,y # what the dvi file thinks they are;
integer wamt,xamt,yamt,zamt # ditto;

integer dvibytecnt # number of bytes output to DVI file;

internal procedure initout # get TEXOUT started properly;
begin
	nooutputyet←true;
	dvibytecnt←0;
	lastpageptr←-1 # to mark first page ;
	arrclr(fontused) # mark all fonts as not being used;
	ofilname←null;
IFSUAI
	ofilext←".DVI"; deviceext←".TFM"; libraryarea←"[XGP,SYS]";
ENDSUAI
IFTOPS10
	ofilext←".DVI"; deviceext←".TFM"; libraryarea←"[,]";
ENDTOPS10
IFMIT
	ofilext←"DVI"; deviceext←"TFM"; libraryarea←"TEX;";
ENDMIT
IFTENEX
	ofilext←".DVI"; deviceext←".TFM"; libraryarea←"PS:<TEX.FONTS>";
ENDTENEX
end;

internal procedure declareofil(string s) # initializes the output on file s;
begin comment This procedure is called when the name of the output file is
first known. It opens the file and gets things started;
ofilname←s;
ifc (SUAI or TOPS10 or MIT) thenc
open(dvichan←getchan,"DSK",8,0,19,0,0,eof);
while true do
	begin enter(dvichan,ofilname,eof);
	if eof then
		begin print(nextline,"I can't write on file ",ofilname);
		if not not_nonstop then quit;
		print(nextline,"Output file = ");
		ofilname←inchwl;
		end
	else done;
	end;
endc
IFTENEX
dvichan←gtjfn(ofilname,1);
while true do
	begin openf(dvichan,3);
	if _skip_ then begin print(nextline,"I can't write on file ",ofilname);
		if not not_nonstop then quit;
		print(nextline,"Output file = ");
		ofilname←inchwl;
		end
	else done;
	end;
ENDTENEX
end;

comment General description of the shipout procedure.

The simplest imaginable shipout routine would essentially be a recursive
procedure that goes through the data structure of the given page and,
whenever coming to a character or rule node, it would cause that character or
rule to be output to the appropriate place depending on its context.
This routine would periodically issue commands to the output device,
saying "Put such-and-such a character (or rule) in such and such a place."

One should probably make use of the fact most of TEX's output is simple
text --  extra care can be taken to make the output occur faster in
simple cases.  Therefore this shipout procedure has been constructed by
taking the simple recursive scheme and augmenting it in this way: A few
common cases have been optimized for in both the coding of TEXOUT, and the
definition of the output language.
;

define rsuperpt={(254000/72.27)} # number of rsu's per point;
integer procedure convert(real x); return(rsuperpt*(x));
comment some macro and subroutine definitions;

integer dviword # pack outbut 4 bytes/word ;

define dvib(byte)={begin
	dviword←(dviword lsh 8) lor (byte land '377);
	if (dvibytecnt←dvibytecnt+1) land '3 = 0 then begin
		wordout(dvichan,dviword lsh 4);
		dviword←0;
		end
	end};

procedure dvi(integer byte); dvib(byte) # slower but smaller;

# the DVI commands;
 define	NOP={128}, BOP={129}, EOP={130}, PST={131}, 
	DVIPUSH={132}, DVIPOP={133},
	VERTRULE={134}, HORZRULE={135}, HORZCHAR={136}, DVIFONT={137},
	W4={138}, W3={139}, W2={140}, W0={141},
	X4={142}, X3={143}, X2={144}, X0={145},
	Y4={146}, Y3={147}, Y2={148}, Y0={149},
	Z4={150}, Z3={151}, Z2={152}, Z0={153},
	FONTNUM={154} # to 217;

# routines for DVI command paramaters;
 define	twobytes(n)={dvi((n) lsh -8); dvi(n)},
	threebytes(n)={dvi((n) lsh -16); twobytes(n)},
	fourbytes(n)={dvi((n) lsh -24); threebytes(n)};
 procedure intout(integer i); begin fourbytes(i); end;

 define Mamt(M)={M}&"amt", 
	M2(M)={M}&"2", M3(M)={M}&"3", M4(M)={M}&"4", M0(M)={M}&"0";
 define move(M,amount)={begin integer amt; amt←rsuperpt*(amount);
	if amt=Mamt(M) then dvi(M0(M))
	else if amt geq 0 then begin
		Mamt(M)←amt;
		if amt<(1 lsh 15) then begin dvi(M2(M)); twobytes(amt); end
		else if amt<(1 lsh 23) then begin
				dvi(M3(M)); threebytes(amt); end
		else begin dvi(M4(M)); fourbytes(amt); end
		end
	else begin
		Mamt(m)←amt;
		if -amt<(1 lsh 15) then begin dvi(M2(M)); twobytes(amt); end
		else if -amt<(1 lsh 23) then begin
				dvi(M3(M)); threebytes(amt); end
		else begin dvi(M4(M)); fourbytes(amt); end
		end
	end};

procedure right(real a); begin if a then move(X,a); x←x+a; end;
procedure down(real a); begin if a then move(Y,a); y←y+a; end;
procedure zdown(real a); begin if a then move(Z,a); y←y+a; end;

# note that the DVI-stack is a parasite of the SAIL stack;
define	push={dvi(DVIPUSH); pshx←x; pshy←y;
# PRINT("PUSH",NEXTLINE);
		pshwamt←wamt; pshxamt←xamt; pshyamt←yamt; pshzamt←zamt},

	pop={dvi(DVIPOP); x←pshx; y←pshy;
# PRINT("POP",NEXTLINE);
		wamt←pshwamt; xamt←pshxamt; yamt←pshyamt; zamt←pshzamt};

define gluesize(r)={(
	if g=0 then gluespace(r)
	else if g>0 then gluespace(r)+gluestretch(r)*g
	else gluespace(r)+glueshrink(r)*g		)};

define setfont(newfont)={
	if newfont neq lastfont then begin
		dvi(FONTNUM+(lastfont←newfont));
		fontused[newfont]←true;
		end};
comment The recursive traversal procedures: vlistout,hlistout;

forward recursive procedure hlistout(integer p) # see below;

recursive procedure vlistout(integer p);
begin comment This procedure generates instruction strings to output the
vlist box pointed to by p.  Upon entry, the coordinates are already set to
where the upper left corner of the vlist should be set;

integer q # runs through the vlist;
integer m # mem[q];
real g # the glueset parameter for this box;
real h,w,d # units of rsu's for heights and widths and depths;
integer r # points to gluespecs; integer i # general use temp;
integer pshwamt,pshxamt,pshyamt,pshzamt; real pshx,pshy # save pushed values ;

# PRINT("DOING VLIST",nextline);
q←value(p); g←glueset(p);
while q do
	begin case field(type,m←mem[q]) of begin
	[charnode] begin integer c,f,w;
# PRINT("H CHAR "&C," ",X," ",Y,NEXTLINE);
	c←field(info,m); f←c lsh -7; w←fontinfo[c] # get character and font;
	setfont(f);
	down(charht(f,w)); dvi(HORZCHAR); dvi(c land '177); down(chardp(f,w));
	end;
	[gluenode] down(gluesize(field(value,m))) # field points to glue spec;
	[kernnode] down(gluespace(q));
	[rulenode] begin comment horizontal rule;
	down(h←(height(q)+depth(q)));
	w←(if width(q) leq -100000.0 then width(p) else width(q));
	dvi(HORZRULE); fourbytes(convert(h)); fourbytes(convert(w)); end;
	[whatsitnode] voutext(q,x,y) # for extensions to TEX;
	[vlistnode] begin 
# PRINT("VLIST WITHIN VLIST ",y,NEXTLINE);
	push; right(shiftamt(q)); vlistout(q); pop;
	down(height(q)+depth(q)); end;
	[hlistnode] begin integer qq,r; # the most common case;
# PRINT("HLIST WITHIN VLIST ",width(q),NEXTLINE);
	zdown(height(q)); push; right(shiftamt(q)); hlistout(q); pop;
	if field(type,m←mem[qq←link(q)])=gluenode then begin # add in gluenode;
		r←field(value,m); down(depth(q)+gluesize(r)); q←qq; end
	else down(depth(q)); end;
	[leadernode] begin integer b; real hh;
	b←field(value,m) # pointer to box used for vertical leaders;
	if type(b) NEQ rulenode then
		begin hh←height(b)+depth(b); if hh<0 then hh←0;
		# so hh has the height of the repeatable thing; end
	else hh←-1.0 # iff variable rule;
	if hh NEQ 0 and type(link(q))=gluenode then
		begin integer r; real limity;
		q←link(q); r←value(q) # pointer to glue spec;
		h←gluesize(r) # the height of the area to be leader-filled;
# PRINT("V LEADER ",Y," + ",H,NEXTLINE);
		limity←y+h # where we should end up after doing the leader;
		if hh>0 then
			begin integer q # quotient; real yy # y surrogate;
			if shiftamt(b)=0 then
				begin q←y/hh-epsilon;
				yy←hh*(q+1) # the smallest suitable multiple of hh;
				end
			else	begin real r; q←h/hh; r←h-q*hh;
				if shiftamt(b)<0 then yy←y+r/2
				else	begin yy←y+r/(q+1); hh←hh+r/(q+1);
					end;
				end;
			comment hh is box size, yy is upper corner of top box;
			down(yy-y) # move to absolute position;
			if type(b)=vlistnode then
				while y+hh LEQ limity+.1 do begin
					push; vlistout(b); pop; down(hh); end
			else while y+hh LEQ limity+.1 do begin
					down(height(b));
					push; hlistout(b); pop;
					zdown(depth(b)); end;
			end
		else begin down(h); dvi(HORZRULE); fourbytes(convert(h));
			fourbytes(convert(width(b))) # ex.3: why HORZ; end;
		down(limity-y) # move to absolute end of leader;
		end # hh neq 0;
	end # leader;
	else end # ignore all other types of nodes;
	q←link(q);
	end # while q do ;
# PRINT("DONE VLIST",NEXTLINE);
end # vlistout;

recursive procedure hlistout(integer p);
begin comment This procedure generates instruction strings to output the
hlist box pointed to by p.  Upon entey, the coordinates are already set to
the location of where the reference point of the hlist should be set;

integer q # runs through the hlist;
integer m # mem[q];
real g # the glueset parameter for this box;
real h,w,d # coordinates in rsu's;
real lastgluesize; integer lastgluespec; # for zipping along sentences;
integer pshwamt,pshxamt,pshyamt,pshzamt; real pshx,pshy # save pushed values ;

# PRINT("DOING HLIST",NEXTLINE);
lastgluespec←-1; # assure no match ;
q←value(p); g←glueset(p);
while q do
	begin case field(type,m←mem[q]) of begin
	[charnode] begin integer c,f,w;
	c←field(info,m) # the extended character code;
	f←c lsh -7 # the font code; w←fontinfo[c] # font information fields;
# PRINT("V CHAR "&C," ",X,"+",charwd(f,w)," ",Y,NEXTLINE);
	setfont(f);
	dvi(c&'177); x←x+charwd(f,w); end;
	[gluenode] begin integer r; r←field(value,m) # pointer to glue spec;
	if r=lastgluespec then dvib(W0)
	else begin # right in here is the only place W moves are used;
		lastgluesize←gluesize(lastgluespec←r);
		move(W,lastgluesize); end;
	x←x+lastgluesize; end;
	[kernnode] right(gluespace(q));
	[rulenode] begin comment vertical rule; w←width(q);
	h←(if height(q) leq -100000.0 then height(p) else height(q));
	d←(if depth(q) leq -100000.0 then depth(p) else depth(q));
# PRINT("VERTICAL RULE at ",x," ",y,nextline);
	if d neq 0 then begin push; down(d);
		dvi(HORZRULE); fourbytes(convert(h+d)); fourbytes(convert(w));
		pop; right(w); end
	else begin
		dvi(VERTRULE); fourbytes(convert(h+d)); fourbytes(convert(w));
		x←x+w;  end;
	end;
	[whatsitnode] houtext(q,x,y) # for extensions to TEX;
	[vlistnode] begin push; 
# PRINT("VLIST WITHIN HLIST ");
	down(-height(q)+shiftamt(q));
	vlistout(q); pop; right(width(q)); end;
	[hlistnode] begin
# PRINT("HLIST WITHIN HLIST ");
	push; down(shiftamt(q)); hlistout(q); pop; right(width(q)); end;
	[leadernode] begin integer b; real ww;
# PRINT("LEADER NODE IN HLIST",NEXTLINE);
	b←field(value,m) # pointer to box used for horizontal leaders;
	if type(b) NEQ rulenode then
		begin ww←width(b); if ww<0 then ww←0;
		end
	else ww←-1.0;
	if ww NEQ 0 and type(link(q))=gluenode then
		begin integer r; real limitx;
		q←link(q); r←value(q) # pointer to glue spec;
		w←gluesize(r);
# PRINT("H LEADER ",X," + ",W,NEXTLINE);
		if ww>0 then
			begin integer q # quotient; real xx # x surrogate;
			if shiftamt(b)=0 then
				begin q←x/ww-epsilon;
				xx←ww*(q+1) # the smallest suitable multiple of ww;
				end
			else	begin real r; q←w/ww; r←w-q*ww;
				if shiftamt(b)<0 then xx←x+r/2
				else	begin xx←x+r/(q+1); ww←ww+r/(q+1);
					end;
				end;
			comment ww is box size, xx is reference point of left box;
			limitx←x+w;
			right(xx-x);
			if type(b)=hlistnode then while x+ww leq limitx+.1 do
				begin push; hlistout(b); pop; right(ww); end
			else while x+ww leq limitx+.1 do begin
				push; down(-height(b));
				vlistout(b); pop; right(ww); end;
			right(limitx-x);
			end
                else if depth(b) neq 0 then begin push; down(depth(b));
                        dvi(HORZRULE); fourbytes(convert(height(b)+depth(b)));
                        fourbytes(convert(w)); pop; right(w); end
                else begin
                        dvi(VERTRULE); fourbytes(convert(height(b)+depth(b)));
                        fourbytes(convert(w)); x←x+w; end;
		end;
	end;
	else end # ignore other node types;
	q←link(q);
	end;
# PRINT("DONE HLIST",NEXTLINE);
end;
internal procedure shipout(integer p) # the main output procedure,produces one page;
begin comment Parameter p points to a vlist box that is to be output;

integer knt;
if ofilname=null then declareofil("TEXOUT.DVI") # make sure DVI file is open;
nooutputyet←false;
maxpagewidth←maxpagewidth max width(p);
maxpageheight←maxpageheight max (height(p)+depth(p));
x←y←0.0;
lastfont←-1 # no assumptions from prior page when we begin a new page;
wamt←xamt←yamt←zamt←(1 lsh 31) # ditto;
thispageptr←dvibytecnt;
dvi(BOP); 
for knt←"0" thru "9" do intout(savedkount[knt]);
intout(lastpageptr);
vlistout(p) # output commands for page text;
dvi(EOP);
lastpageptr←thispageptr;
end;

internal procedure closeout # just before TEX stops, do this;
begin
integer postambleptr,f,i; string s;
if nooutputyet then begin print("No output file.",nextline); return; end;
postambleptr←dvibytecnt;
dvi(PST); # marks postamble ;
intout(lastpageptr);
intout(1); intout(1); # since we output in RSU's;
intout(rfudge);
intout(convert(maxpageheight)); intout(convert(maxpagewidth));
for f←0 thru nfonts-1 do if fontused[f] then begin
	intout(f);
	intout(fcksum[f] lsh -4);
	intout(1000*fsize[f]/dsize[f]);
	dvi(length(dvifontname[f]));
	while(i←lop(dvifontname[f])) do dvi(i);
	end;
intout(-1) # mark end of fonts;
intout(postambleptr);
dvi(1); for i←1 step 1 until 10 do dvi(223) # to ensure written buffer;
ifc (SUAI or TOPS10 or MIT) thenc
release(dvichan);
endc
IFTENEX
cfile(dvichan);
ENDTENEX

IFTOPS20
s←"";
while (i←inchrs)>0 do if i neq 10 then s←s&i;
s←"DVIPRE "&ofilname&s # suggest a DVI to PRESS command;
while s do sti('101,lop(s));
ENDTOPS20
end # closeout ;

end # of TEXOUT ;